home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0102_Silence Speaker Sound.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.2 KB  |  175 lines
  1. {
  2. If you want absolute silence (no ticks and very short beeps you get with the
  3. timer interrupt approach), and you are running QEMM 7.03 or higher, you can
  4. use this.If anyone is interested, I have also some sources with the same
  5. routines to capture IO access under QEMM.
  6. ===
  7. { NoSound, PC Speaker sound killer for QEMM 7.03+, Arne de Bruijn, 19960405. }
  8. { Released to the Public Domain. }
  9. { Run it to install, run with /U to remove it. }
  10. {$G+}
  11. uses dos;
  12. { Resident part }
  13. { Only code segment will be preserved, so necessary variables are stored here
  14. }procedure QPI_CS; assembler; asm db 0,0,0; end;
  15. procedure OldTrap_CS; assembler; asm end;
  16. procedure OldIOTrap_CS; assembler; asm db 0,0,0; end;
  17.  
  18. procedure MyTrap; far; assembler; { Called when something accesses port $61 }
  19. asm
  20.  test cl,4      { Is the program writing to port $61? }
  21.  jne @IsWrite   { Yes, jump to @IsWrite }
  22.  push bx
  23.  mov bx,ax
  24.  mov ax,1a05h   { Pass port read to QEMM, to execute it }
  25.  call dword ptr cs:[QPI_CS]
  26.  mov ax,bx
  27.  pop bx
  28.  retf
  29. @IsWrite:
  30.  and al,not 2   { Clear speaker bits, so it's always off }
  31.  push bx
  32.  mov bx,ax
  33.  mov ax,1a05h   { Pass port write to QEMM, to execute it }
  34.  call dword ptr cs:[QPI_CS]
  35.  mov ax,bx
  36.  pop bx
  37. end;
  38.  
  39. procedure End_Of_TSR_Label; assembler; asm end;
  40.  
  41. type
  42.  TPtr=record Ofs,Seg:word; end;
  43. const
  44.  QPI:pointer=NIL;
  45. function GetQemmApi(var QPI:pointer):boolean; assembler;
  46. asm
  47.  mov ah,3fh
  48.  mov cx,'QE'
  49.  mov dx,'MM'
  50.  int 67h
  51.  mov al,0
  52.  test ah,ah
  53.  jnz @NoQemm
  54.  mov ax,di
  55.  mov dx,es
  56.  cld
  57.  les di,QPI
  58.  stosw
  59.  mov ax,dx
  60.  stosw
  61.  mov al,1
  62. @NoQemm:
  63. end;
  64.  
  65. procedure QPI_SetIOCallback(IOCallback:pointer); assembler;
  66. asm
  67.  mov ax,1a07h
  68.  les di,IOCallback
  69.  call [QPI]
  70. end;
  71.  
  72. function QPI_GetPortTrap(PortNo:word):boolean; assembler;
  73. asm
  74.  mov ax,1a08h
  75.  mov dx,PortNo
  76.  call [QPI]
  77.  mov al,bl
  78. end;
  79.  
  80. procedure QPI_SetPortTrap(PortNo:word); assembler;
  81. asm
  82.  mov ax,1a09h
  83.  mov dx,PortNo
  84.  call [QPI]
  85. end;
  86.  
  87. procedure QPI_ClearPortTrap(PortNo:word); assembler;
  88. asm
  89.  mov ax,1a0ah
  90.  mov dx,PortNo
  91.  call [QPI]
  92. end;
  93.  
  94. function QPI_GetVersion(var Version:word):boolean; assembler;
  95. asm
  96.  mov ax,word ptr [QPI]
  97.  or ax,word ptr [QPI+2]
  98.  jz @NoQemm
  99.  mov ah,3
  100.  call [QPI]
  101.  jc @NoQemm
  102.  les di,Version
  103.  stosw
  104.  mov al,1
  105.  db 0a9h { Skip following instruction (2 bytes) }
  106. @NoQemm:
  107.  mov al,0
  108. end;
  109.  
  110. procedure QPI_GetIOCallback(var IOCallBack:pointer); assembler;
  111. asm
  112.  mov ax,1a06h
  113.  call [QPI]
  114.  mov ax,di
  115.  mov dx,es
  116.  cld
  117.  les di,IOCallBack
  118.  stosw
  119.  mov ax,dx
  120.  stosw
  121. end;
  122.  
  123. var
  124.  W:word;
  125.  OldIOTrap:pointer;
  126.  S:string[2];
  127. begin
  128.  if not GetQemmApi(QPI) then
  129.   begin WriteLn('QEMM not installed!'); Halt(1); end;
  130.  pointer((@QPI_CS)^):=QPI;
  131.  if not QPI_GetVersion(W) then
  132.   begin WriteLn('QPI_GetVersion error!'); Halt(1); end;
  133.  if W<$0703 then
  134.   begin WriteLn('Need QEMM 7.03+'); Halt(1); end;
  135.  QPI_GetIOCallback(OldIOTrap); { Get current IO trap function }
  136.  if word(OldIOTrap)=Ofs(MyTrap) then { Ours? }
  137.   begin
  138.    S:=ParamStr(1); S[2]:=Upcase(S[2]);
  139.    if S<>'/U' then
  140.     WriteLn('NoSound already installed! Use /U to unload.')
  141.    else
  142.     begin
  143.      { Restore port trap state }
  144.      if not boolean(ptr(TPtr(OldIOTrap).Seg,ofs(OldTrap_CS))^) then
  145.       QPI_ClearPortTrap($61);
  146.      QPI_SetIOCallback(pointer(ptr(TPtr(OldIOTrap).Seg,ofs(OldIOTrap_CS))^));
  147.      W:=TPtr(OldIOTrap).Seg-$10;  { TSR PSP segment (just under code segment)
  148. }     asm
  149.       mov ah,49h         { DOS function 'Free memory block' }
  150.       mov es,W           { Get TSR PSP segment }
  151.       push es            { Save it }
  152.       mov es,es:[2ch]    { Get TSR environment segment }
  153.       int 21h            { Free it }
  154.       mov ah,49h         { Again 'Free memory block' }
  155.       pop es             { Restore TSR PSP segment }
  156.       int 21h            { Free it }
  157.      end;
  158.      WriteLn('NoSound removed.');
  159.     end;
  160.    Halt(0);
  161.   end;
  162.  QPI_SetIOCallback(@MyTrap);
  163.  pointer((@OldIOTrap_CS)^):=OldIOTrap;
  164.  boolean((@OldTrap_CS)^):=QPI_GetPortTrap($61);
  165.  QPI_SetPortTrap($61);
  166.  WriteLn('NoSound installed.');
  167.  swapvectors;
  168.  asm
  169.   mov ax,3100h   { DOS function 'Terminate and stay resident' }
  170.   mov dx,offset End_Of_Tsr_Label+15+256  { Calculate resident size }
  171.   shr dx,4       { Scale down to paragraphs }
  172.   int 21h        { Go TSR }
  173.  end;
  174. end.
  175.